home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
os2
/
adaptor.zip
/
ADAPT.ZIP
/
adaptor
/
src
/
adaptser.c
< prev
next >
Wrap
Text File
|
1994-01-03
|
13KB
|
572 lines
# include "Serial.h"
# include "yyASeria.w"
# include <stdio.h>
# if defined __STDC__ | defined __cplusplus
# include <stdlib.h>
# else
extern void exit ();
# endif
# include "Tree.h"
# include "Definiti.h"
# ifndef NULL
# define NULL 0L
# endif
# ifndef false
# define false 0
# endif
# ifndef true
# define true 1
# endif
# ifdef yyInline
# define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) \
if ((ptr = (tree) free) >= (tree) max) ptr = alloc (); \
free += nodesize [kind]; \
ptr->yyHead.yyMark = 0; \
ptr->Kind = kind;
# else
# define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) ptr = make (kind);
# endif
# define yyWrite(s) (void) fputs (s, yyf)
# define yyWriteNl (void) fputc ('\n', yyf)
# line 26 "AdaptSerial.puma"
# include <stdio.h>
# include "Idents.h"
# include "StringMe.h"
# include "protocol.h"
# include "Types.h"
# include "Transfor.h" /* CombineACF, ... */
# include "Shapes.h"
# include "TempScal.h" /* temporary scalar for array assignment */
# include "F77.h" /* F77Assign */
# include "Forall.h" /* TransformFORALL */
# include "DoLocal.h" /* TransformDoLocal */
static FILE * yyf = stdout;
static void yyAbort
# ifdef __cplusplus
(char * yyFunction)
# else
(yyFunction) char * yyFunction;
# endif
{
(void) fprintf (stderr, "Error: module AdaptSerial, routine %s failed\n", yyFunction);
exit (1);
}
void AdaptSerial ARGS((tTree t));
static tTree AdaptACFForall ARGS((tTree t));
static tTree AdaptACFDoLocal ARGS((tTree t));
static tTree CheckArrayAssignment ARGS((tTree assign, int vardist, int expdist));
void AdaptSerial
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
# line 53 "AdaptSerial.puma"
tObject Obj;
if (t == NoTree) return;
if (t->Kind == kCOMP_UNIT) {
# line 57 "AdaptSerial.puma"
{
# line 58 "AdaptSerial.puma"
open_protocol ("adaptor.seq");
# line 59 "AdaptSerial.puma"
AdaptSerial (t->COMP_UNIT.COMP_ELEMENTS);
# line 60 "AdaptSerial.puma"
close_protocol ();
}
return;
}
if (t->Kind == kDECL_EMPTY) {
# line 63 "AdaptSerial.puma"
return;
}
if (t->Kind == kDECL_LIST) {
if (t->DECL_LIST.Elem->Kind == kPROGRAM_DECL) {
# line 66 "AdaptSerial.puma"
{
tDefinitions Obj;
{
# line 67 "AdaptSerial.puma"
# line 68 "AdaptSerial.puma"
set_protocol_unit (t->DECL_LIST.Elem);
# line 69 "AdaptSerial.puma"
Obj = GetDeclEntry (t->DECL_LIST.Elem->PROGRAM_DECL.Name, GetUnitEntries ());
# line 70 "AdaptSerial.puma"
OpenScope (Obj->ProcObject.Declarations);
# line 71 "AdaptSerial.puma"
AdaptSerial (t->DECL_LIST.Elem->PROGRAM_DECL.PROGRAM_BODY);
# line 72 "AdaptSerial.puma"
CloseScope ();
# line 73 "AdaptSerial.puma"
AdaptSerial (t->DECL_LIST.Next);
}
return;
}
}
if (t->DECL_LIST.Elem->Kind == kPROC_DECL) {
# line 76 "AdaptSerial.puma"
{
tDefinitions Obj;
{
# line 77 "AdaptSerial.puma"
# line 78 "AdaptSerial.puma"
set_protocol_unit (t->DECL_LIST.Elem);
# line 79 "AdaptSerial.puma"
Obj = GetDeclEntry (t->DECL_LIST.Elem->PROC_DECL.Name, GetUnitEntries ());
# line 80 "AdaptSerial.puma"
OpenScope (Obj->ProcObject.Declarations);
# line 81 "AdaptSerial.puma"
AdaptSerial (t->DECL_LIST.Elem->PROC_DECL.PROC_BODY);
# line 82 "AdaptSerial.puma"
CloseScope ();
# line 83 "AdaptSerial.puma"
AdaptSerial (t->DECL_LIST.Next);
}
return;
}
}
if (t->DECL_LIST.Elem->Kind == kFUNC_DECL) {
# line 86 "AdaptSerial.puma"
{
tDefinitions Obj;
{
# line 87 "AdaptSerial.puma"
# line 88 "AdaptSerial.puma"
set_protocol_unit (t->DECL_LIST.Elem);
# line 89 "AdaptSerial.puma"
Obj = GetDeclEntry (t->DECL_LIST.Elem->FUNC_DECL.Name, GetUnitEntries ());
# line 90 "AdaptSerial.puma"
OpenScope (Obj->FuncObject.Declarations);
# line 91 "AdaptSerial.puma"
AdaptSerial (t->DECL_LIST.Elem->FUNC_DECL.FUNC_BODY);
# line 92 "AdaptSerial.puma"
CloseScope ();
# line 93 "AdaptSerial.puma"
AdaptSerial (t->DECL_LIST.Next);
}
return;
}
}
if (t->DECL_LIST.Elem->Kind == kBLOCK_DATA_DECL) {
# line 96 "AdaptSerial.puma"
{
tDefinitions Obj;
{
# line 97 "AdaptSerial.puma"
# line 98 "AdaptSerial.puma"
set_protocol_unit (t->DECL_LIST.Elem);
# line 99 "AdaptSerial.puma"
Obj = GetDeclEntry (t->DECL_LIST.Elem->BLOCK_DATA_DECL.Name, GetUnitEntries ());
# line 100 "AdaptSerial.puma"
OpenScope (Obj->BlockObject.Declarations);
# line 101 "AdaptSerial.puma"
AdaptSerial (t->DECL_LIST.Elem->BLOCK_DATA_DECL.DATA_BODY);
# line 102 "AdaptSerial.puma"
CloseScope ();
# line 103 "AdaptSerial.puma"
AdaptSerial (t->DECL_LIST.Next);
}
return;
}
}
}
if (t->Kind == kBODY_NODE) {
# line 106 "AdaptSerial.puma"
{
# line 107 "AdaptSerial.puma"
if (! (AdaptACFForall (t))) goto yyL7;
{
# line 108 "AdaptSerial.puma"
TempScalarsInitBody (t);
# line 109 "AdaptSerial.puma"
if (! (AdaptACFDoLocal (t))) goto yyL7;
{
# line 110 "AdaptSerial.puma"
TempScalarsDoneBody (t);
}
}
}
return;
yyL7:;
}
;
}
static tTree AdaptACFForall
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
# line 129 "AdaptSerial.puma"
int i;
tTree newacf;
switch (t->Kind) {
case kBODY_NODE:
# line 134 "AdaptSerial.puma"
{
# line 135 "AdaptSerial.puma"
t->BODY_NODE.STATS = AdaptACFForall (t->BODY_NODE.STATS);
}
return t;
case kACF_LIST:
# line 139 "AdaptSerial.puma"
{
# line 140 "AdaptSerial.puma"
set_protocol_stmt (t->ACF_LIST.Elem);
newacf = AdaptACFForall (t->ACF_LIST.Elem);
t->ACF_LIST.Next = AdaptACFForall (t->ACF_LIST.Next);
newacf = ReplaceACF (t, newacf, t->ACF_LIST.Next);
}
return newacf;
case kACF_BASIC:
if (t->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
# line 148 "AdaptSerial.puma"
return t;
}
if (t->ACF_BASIC.BASIC_STMT->Kind == kCALL_STMT) {
# line 152 "AdaptSerial.puma"
return t;
}
if (t->ACF_BASIC.BASIC_STMT->Kind == kALLOCATE_STMT) {
# line 156 "AdaptSerial.puma"
{
# line 157 "AdaptSerial.puma"
SetAllocateShapes (t->ACF_BASIC.BASIC_STMT->ALLOCATE_STMT.PARAMS);
}
return t;
}
if (t->ACF_BASIC.BASIC_STMT->Kind == kDEALLOCATE_STMT) {
# line 161 "AdaptSerial.puma"
{
# line 162 "AdaptSerial.puma"
ResetDeallocateShapes (t->ACF_BASIC.BASIC_STMT->DEALLOCATE_STMT.PARAMS);
}
return t;
}
if (t->ACF_BASIC.BASIC_STMT->Kind == kIO_STMT) {
# line 166 "AdaptSerial.puma"
return t;
}
# line 170 "AdaptSerial.puma"
return t;
case kACF_EMPTY:
# line 175 "AdaptSerial.puma"
return t;
case kACF_DUMMY:
# line 179 "AdaptSerial.puma"
return t;
case kACF_WHILE:
# line 183 "AdaptSerial.puma"
{
# line 184 "AdaptSerial.puma"
t->ACF_WHILE.WHILE_BODY = AdaptACFForall (t->ACF_WHILE.WHILE_BODY);
}
return t;
case kACF_DO:
# line 188 "AdaptSerial.puma"
{
# line 189 "AdaptSerial.puma"
t->ACF_DO.DO_BODY = AdaptACFForall (t->ACF_DO.DO_BODY);
}
return t;
case kACF_DOLOCAL:
# line 193 "AdaptSerial.puma"
{
# line 195 "AdaptSerial.puma"
t->ACF_DOLOCAL.DOLOCAL_BODY = AdaptACFForall (t->ACF_DOLOCAL.DOLOCAL_BODY);
}
return t;
case kACF_FORALL:
# line 199 "AdaptSerial.puma"
return TransformFORALL (t);
case kACF_IF:
# line 206 "AdaptSerial.puma"
{
# line 207 "AdaptSerial.puma"
t->ACF_IF.THEN_PART = AdaptACFForall (t->ACF_IF.THEN_PART);
t->ACF_IF.ELSE_PART = AdaptACFForall (t->ACF_IF.ELSE_PART);
}
return t;
case kACF_WHERE:
# line 213 "AdaptSerial.puma"
return t;
}
# line 217 "AdaptSerial.puma"
{
# line 218 "AdaptSerial.puma"
printf ("AdaptACFForall failed\n");
# line 219 "AdaptSerial.puma"
WriteTree (stdout, t);
# line 220 "AdaptSerial.puma"
kill_in_protocol ();
}
return t;
}
static tTree AdaptACFDoLocal
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
# line 239 "AdaptSerial.puma"
int i;
tTree newacf;
switch (t->Kind) {
case kBODY_NODE:
# line 244 "AdaptSerial.puma"
{
# line 245 "AdaptSerial.puma"
t->BODY_NODE.STATS = AdaptACFDoLocal (t->BODY_NODE.STATS);
}
return t;
case kACF_LIST:
# line 249 "AdaptSerial.puma"
{
# line 250 "AdaptSerial.puma"
set_protocol_stmt (t->ACF_LIST.Elem);
newacf = AdaptACFDoLocal (t->ACF_LIST.Elem);
t->ACF_LIST.Next = AdaptACFDoLocal (t->ACF_LIST.Next);
newacf = ReplaceACF (t, newacf, t->ACF_LIST.Next);
}
return newacf;
case kACF_BASIC:
if (t->ACF_BASIC.BASIC_STMT->Kind == kCALL_STMT) {
# line 258 "AdaptSerial.puma"
return t;
}
if (t->ACF_BASIC.BASIC_STMT->Kind == kALLOCATE_STMT) {
# line 270 "AdaptSerial.puma"
{
# line 271 "AdaptSerial.puma"
SetAllocateShapes (t->ACF_BASIC.BASIC_STMT->ALLOCATE_STMT.PARAMS);
}
return t;
}
if (t->ACF_BASIC.BASIC_STMT->Kind == kDEALLOCATE_STMT) {
# line 275 "AdaptSerial.puma"
{
# line 276 "AdaptSerial.puma"
ResetDeallocateShapes (t->ACF_BASIC.BASIC_STMT->DEALLOCATE_STMT.PARAMS);
}
return t;
}
if (t->ACF_BASIC.BASIC_STMT->Kind == kIO_STMT) {
# line 280 "AdaptSerial.puma"
return t;
}
if (t->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
# line 284 "AdaptSerial.puma"
{
# line 288 "AdaptSerial.puma"
if (! ((TreeRank (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR) > 0))) goto yyL7;
{
# line 289 "AdaptSerial.puma"
if (! ((TreeRank (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP) == 0))) goto yyL7;
{
# line 290 "AdaptSerial.puma"
if (! ((CountMovements (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP) > 0))) goto yyL7;
}
}
}
return CheckArrayAssignment (t, TreeDistribution (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR), TreeDistribution (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP));
yyL7:;
}
# line 296 "AdaptSerial.puma"
return t;
case kACF_EMPTY:
# line 301 "AdaptSerial.puma"
return t;
case kACF_DUMMY:
# line 305 "AdaptSerial.puma"
return t;
case kACF_WHILE:
# line 309 "AdaptSerial.puma"
{
# line 310 "AdaptSerial.puma"
t->ACF_WHILE.WHILE_BODY = AdaptACFDoLocal (t->ACF_WHILE.WHILE_BODY);
}
return t;
case kACF_DO:
# line 314 "AdaptSerial.puma"
{
# line 315 "AdaptSerial.puma"
t->ACF_DO.DO_BODY = AdaptACFDoLocal (t->ACF_DO.DO_BODY);
}
return t;
case kACF_DOLOCAL:
# line 319 "AdaptSerial.puma"
return TransformDoLocal (t);
case kACF_IF:
# line 324 "AdaptSerial.puma"
{
# line 325 "AdaptSerial.puma"
t->ACF_IF.THEN_PART = AdaptACFDoLocal (t->ACF_IF.THEN_PART);
t->ACF_IF.ELSE_PART = AdaptACFDoLocal (t->ACF_IF.ELSE_PART);
}
return t;
case kACF_WHERE:
# line 331 "AdaptSerial.puma"
return t;
}
# line 335 "AdaptSerial.puma"
{
# line 336 "AdaptSerial.puma"
printf ("AdaptACFDoLocal failed\n");
# line 337 "AdaptSerial.puma"
WriteTree (stdout, t);
# line 338 "AdaptSerial.puma"
kill_in_protocol ();
}
return t;
}
static tTree CheckArrayAssignment
# if defined __STDC__ | defined __cplusplus
(register tTree assign, register int vardist, register int expdist)
# else
(assign, vardist, expdist)
register tTree assign;
register int vardist;
register int expdist;
# endif
{
if (assign->Kind == kACF_BASIC) {
if (assign->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
# line 353 "AdaptSerial.puma"
{
tTree new;
{
# line 355 "AdaptSerial.puma"
if (! ((expdist != 0))) goto yyL1;
{
# line 357 "AdaptSerial.puma"
# line 359 "AdaptSerial.puma"
assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP = ExtractScalarMovements (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP, &new);
if (new != NoTree)
{ tTree new_assign;
if (target_language == FORTRAN_77)
{ new_assign = F77Assign (assign);
new_assign = TransformFORALL (new_assign);
new_assign = TransformDoLocal (new_assign);
}
else
new_assign = assign;
new = CombineACF (new, mACF_LIST (new_assign, NoTree));
stmt_protocol ("array = scalar (distributed) resolved");
tree_protocol ("new statements are : \n", new);
}
else
new = assign;
}
}
{
return new;
}
}
yyL1:;
}
}
# line 387 "AdaptSerial.puma"
return assign;
}
void BeginAdaptSerial ()
{
}
void CloseAdaptSerial ()
{
}